home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / CMPLTPAS / CREATLBL.PAS < prev    next >
Pascal/Delphi Source File  |  1988-07-14  |  4KB  |  84 lines
  1. {->>>>CreateLabel<<<<------------------------------------------}
  2. {                                                              }
  3. { Filename : CREATLBL.SRC -- Last Modified 7/11/88             }
  4. {                                                              }
  5. { This procedure creates a new volume label on the unlabeled   }
  6. { DOS volume passed in DriveSpec.  No check is made            }
  7. { as to the validity of the character in DriveSpec; if there   }
  8. { is no corresponding drive the system may hang or return an   }
  9. { error depending on the specifics.  If a volume label already }
  10. { exists on the specified volume, CreatedLabel will return     }
  11. { FALSE with an ErrorReturn value of 0.  This is not really an }
  12. { error condition, but DOS makes no provision for altering a   }
  13. { volume label that already exists, so at best we go home with }
  14. { our tail between our legs.  If some sort of true error       }
  15. { occurs, the DOS error code will be returned in ErrorReturn,  }
  16. { and CreatedLabel will be set to FALSE.  If CreatedLabel      }
  17. { comes back TRUE, the label was in fact created.              }
  18. {                                                              }
  19. { Function GetLabel must be predefined.                        }
  20. {                                                              }
  21. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  22. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  23. {--------------------------------------------------------------}
  24.  
  25. PROCEDURE CreateLabel(DriveSpec        : String;
  26.                       NewLabel         : String;
  27.                       VAR CreatedLabel : Boolean;
  28.                       VAR ErrorReturn  : Word;
  29.                       ShowError        : Boolean);
  30.  
  31. TYPE
  32.   ErrorCode = 0..18;    { DOS function call error codes }
  33.   String80  = String[80];
  34.  
  35. VAR
  36.   I            : Integer;
  37.   SearchSpec   : String80;
  38.   FileSpec     : String80;
  39.   CurrentLabel : String80;
  40.   Regs         : Registers;
  41.   ASCIIZ       : ARRAY[1..81] OF Char;
  42.   DTA          : SearchRec;
  43.   Error        : ErrorCode;
  44.   FoundLabel   : Boolean;
  45.  
  46. BEGIN
  47.   CurrentLabel := GetLabel(DriveSpec,FoundLabel);
  48.   IF NOT FoundLabel THEN { No label exists yet }
  49.     BEGIN
  50.       FileSpec := DriveSpec + '\' + NewLabel + Chr(0);
  51.       Move(FileSpec[1],ASCIIZ,Sizeof(FileSpec));
  52.  
  53.       WITH Regs DO
  54.         BEGIN
  55.           AH := $3C;          { $3C = Create File }
  56.           DS := Seg(ASCIIZ);  { Put address of ASCIIZ }
  57.           DX := Ofs(ASCIIZ);  { in DS : DX }
  58.           CL := $08;          { Set Volume Label attribute }
  59.         END;
  60.       MSDOS(Regs);                   { Make CHMOD DOS call }
  61.  
  62.       { If the Carry Flag is found to be set, it's an error: }
  63.       IF (Regs.Flags AND $0001) = 1 THEN
  64.         BEGIN
  65.           CreatedLabel := False;   { No luck }
  66.           ErrorReturn := Regs.AX;  { Return error code as parameter }
  67.           Error := ErrorReturn;    { Make an ordinal of the error code }
  68.           IF ShowError THEN
  69.             CASE Error OF
  70.               2 : Writeln('Label file not found.');
  71.               3 : Writeln('Bad path error -- possible disk failure.');
  72.               5 : Writeln('Access to label denied -- Disk write protected?');
  73.               ELSE Writeln('Unexpected DOS error ',Error,' on label write.')
  74.             END; { CASE }
  75.         END
  76.       ELSE CreatedLabel := True   { No error - created the label }
  77.     END
  78.   ELSE    { Label already exists; can't re-create it... }
  79.     BEGIN
  80.       CreatedLabel := False;
  81.       ErrorReturn := 0;
  82.     END
  83. END;
  84.